(*
 *
 *)

#use "string.ml";;

type 'a nodept = End of char * 'a 
               | Node of char * 'a nodept list 
               | NodeEnd of char * 'a * 'a nodept list ;;

type 'a prefixtree = ('a nodept) list ;;

exception NP;;
exception KE;;
exception KNE;;

let creatept() = [] ;;

let getkey node =
        match node with
          End(c,_) -> c
        | Node(c,_) -> c
        | NodeEnd(c,_,_) -> c ;;

let rec insertpt (k,v) = 
        if (length k) > 1
           then 
              ( 
                let sk = sub k 1 (length k -1)
                in let st = [insertpt (sk,v) ]
                   in (Node(k.[0], st))
              )
           else (End(k.[0], v));;


let rec addpt ?(replace = false) (k,v) t  =
        match t with
          [] -> [insertpt (k,v) ]
        | x::y 
             -> ( match getkey x with 
                    c when(c <  k.[0]) 
                      -> x::(addpt ~replace:replace (k,v) y)
                  | c when(c >  k.[0])
                      -> let nn = insertpt (k,v) 
                         in nn::x::y
                  | c -> 
                         let lk = (length k) = 1
                         in let nn = (match x, lk with
                              End(ce, ve), true -> if replace
                                                      then End(c, v)
                                                      else raise  KE
                            | End(ce, ve), false -> let sk =  sub k 1 (length k -1)
                                                    in NodeEnd(ce,ve, [insertpt (sk,v)])

                            | Node(c, st), true -> NodeEnd(c,v,st)
                            | Node(c, st), false -> let sk = sub k 1 (length k -1)
                                                    in Node(c, addpt  ~replace:replace (sk,v) st)

                            | NodeEnd(ce, ve, st),true -> if replace
                                                             then NodeEnd(c,v,st)
                                                             else raise KE
                            | NodeEnd(ce, ve, st),false -> let sk = sub k 1 (length k -1)
                                                    in NodeEnd(ce, ve, addpt ~replace:replace (sk,v) st)
                         
                            ) in nn::y 
                 );;
      

let rec lookuppt k t =
        match t with
           [] -> None
        | x::y
             -> ( match getkey x with 
                    c when(c <  k.[0]) 
                      -> lookuppt k y
                  | c when(c >  k.[0])
                      -> None 
                  | c -> 
                         let lk = (length k) = 1
                         in (match x, lk with
                               End(ce, ve), true -> Some(ve)
                             | End(ce, ve), false -> None
   
                             | Node(c, st), true -> None
                             | Node(c, st), false -> let sk = sub k 1 (length k -1)
                                                     in lookuppt sk st
                             | NodeEnd(ce, ve, st),true -> Some(ve)
                             | NodeEnd(ce, ve, st),false -> let sk = sub k 1 (length k -1)
                                                     in lookuppt sk st
                          
                             )  
                 );;

let c2s c = Char.escaped c ;;
           
let rec pt2list t =
        let rec aux t acc=
           match t with
             [] -> []
           | x::y 
                -> let xl = 
                      match x with
                        End(c,v) -> [(acc^(c2s c), v)]
                      | NodeEnd(c,v,st) -> (acc^(c2s c), v)::(aux st (acc^(c2s c)))
                      | Node(c,st)-> aux st (acc^(c2s c))
                   in xl@(aux y acc) 
        in aux t "";;

let list2pt l =
     let rec aux l t =
           match l with
              [] -> t
           | x::y -> let nt = addpt x t 
                     in aux y nt
     in aux l (creatept()) ;;

type 'a map = 'a prefixtree;;

let createmap() = creatept();;

let addmap (k,v) map =
        addpt (k,v) map;;

let changemap (k,v) map =
        addpt ~replace:true (k,v) map  ;;

let isinmap k map =
        match lookuppt k map with
           None -> false
        |  Some(_) -> true ;;

let lookupmap k map =
        match lookuppt k map with
           None -> raise KNE 
        |  Some(v) -> v ;;


 
let t = creatept();;
let t1 = addpt ("ch", 10) t;;
let t2 = addpt ("c" ,20) t1;;
let t3 = addpt ("cha", 30) t2;;
let t4 = addpt ("a" ,40) t3;;
let t5 = addpt ("chan", 50) t4;;
let t6 = addpt ("az" ,60) t5;;
let t7 = addpt ("channel", 70) t6;;

